home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
c
/
lex.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
2KB
|
114 lines
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
lex.c
lexical environment
*/
#include "include.h"
object
assoc_eq(key, alist)
object key, alist;
{
while (!endp(alist)) {
if (MMcaar(alist) == key)
return(MMcar(alist));
alist = MMcdr(alist);
}
return(Cnil);
}
lex_fun_bind(name, fun)
object name, fun;
{
object *top = vs_top;
vs_push(make_cons(fun, Cnil));
top[0] = make_cons(Sfunction, top[0]);
top[0] = make_cons(name, top[0]);
lex_env[1] = make_cons(top[0],lex_env[1]);
vs_top = top;
}
lex_macro_bind(name, exp_fun)
object name, exp_fun;
{
object *top = vs_top;
vs_push(make_cons(exp_fun, Cnil));
top[0] = make_cons(Smacro, top[0]);
top[0] = make_cons(name, top[0]);
lex_env[1]=make_cons(top[0], lex_env[1]);
vs_top = top;
}
lex_tag_bind(tag, id)
object tag, id;
{
object *top = vs_top;
vs_push(make_cons(id, Cnil));
top[0] = make_cons(Stag, top[0]);
top[0] = make_cons(tag, top[0]);
lex_env[2] =make_cons(top[0], lex_env[2]);
vs_top = top;
}
lex_block_bind(name, id)
object name, id;
{
object *top = vs_top;
vs_push(make_cons(id, Cnil));
top[0] = make_cons(Sblock, top[0]);
top[0] = make_cons(name, top[0]);
lex_env[2]= make_cons(top[0], lex_env[2]);
vs_top = top;
}
object
lex_tag_sch(tag)
object tag;
{
object alist = lex_env[2];
while (!endp(alist)) {
if (eql(MMcaar(alist), tag) && MMcadar(alist) == Stag)
return(MMcar(alist));
alist = MMcdr(alist);
}
return(Cnil);
}
object lex_block_sch(name)
object name;
{
object alist = lex_env[2];
while (!endp(alist)) {
if (MMcaar(alist) == name && MMcadar(alist) == Sblock)
return(MMcar(alist));
alist = MMcdr(alist);
}
return(Cnil);
}
init_lex()
{
Sfunction = make_ordinary("FUNCTION");
enter_mark_origin(&Sfunction);
Smacro = make_ordinary("MACRO");
enter_mark_origin(&Smacro);
Stag = make_ordinary("TAG");
enter_mark_origin(&Stag);
Sblock = make_ordinary("BLOCK");
enter_mark_origin(&Sblock);
}